home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbmf2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-07  |  29.5 KB  |  730 lines
  1. (*===========================================================================*)
  2. (* Add/Update messages                                                       *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991, 1992 by H. Roy Engehausen.  All       *)
  5. (*   rights reserved.                                                        *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. (*===========================================================================*)
  10. (* Add current msg to message list                                           *)
  11. (*===========================================================================*)
  12.  
  13. PROCEDURE add_msg(fileid : STRING; pass_dupe_bid : BOOLEAN);
  14.  
  15.   VAR
  16.     actions_done         : action_msg_type;
  17.     bid_is_dupe          : BOOLEAN;
  18.     bid_forced           : BOOLEAN;
  19.     buff_add             : msg_block_ptr;
  20.     i                    : INTEGER;
  21.     j                    : WORD;
  22.     msg_index_current    : msg_index_ptr;
  23.     str_ptr              : ^STRING;
  24.     t_id                 : file_name_str;
  25.     t_dest               : bb_addr_str;
  26.     temp_file            : FILE;
  27.     temp_str             : STRING[20];
  28.     temp_type            : action_msg_type;
  29.     this_act             : action_msg_ptr;
  30.  
  31.   LABEL
  32.     find_next_action;
  33.  
  34.   {$I BBMF2A.PAS}
  35.  
  36.   {$UNDEF  DEBUG_HOLD}
  37.   {$UNDEF  DEBUG_ACT}   (* Used to debug ACTIONs *)
  38.   {$UNDEF  DEBUG_TIME}  (* Debug timing          *)
  39.  
  40.   BEGIN;
  41.  
  42.     (*-----------------------------------------------------------------------*)
  43.     (* Obtain the interrupt lock                                             *)
  44.     (*-----------------------------------------------------------------------*)
  45.  
  46.     get_semaphore(semaphore_interrupts, sem_exclusive, FALSE);
  47.  
  48.     WITH active_tcb^.curr_msg.msg_i_mb DO
  49.       BEGIN;
  50.  
  51.         (*-------------------------------------------------------------------*)
  52.         (* Generate a msg number                                             *)
  53.         (*-------------------------------------------------------------------*)
  54.  
  55.         msg_number  := next_msg_no;
  56.         IF msg_no_orig = 0 THEN
  57.           msg_no_orig := msg_number;
  58.  
  59.         INC(next_msg_no);
  60.  
  61.         (*-------------------------------------------------------------------*)
  62.         (* Message number warning                                            *)
  63.         (*-------------------------------------------------------------------*)
  64.  
  65.         IF next_msg_no > 65530 THEN
  66.           BEGIN;
  67.             WRITELN;
  68.             WRITELN;
  69.             WRITELN('You cannot exceed message number 65530.  You need to');
  70.             WRITELN('issue a GR command to renumber your messages before');
  71.             WRITELN('adding another message.');
  72.             WRITELN;
  73.             WRITELN;
  74.             RUNERROR(max_msg_number_err);
  75.           END;
  76.  
  77.         IF (next_msg_no > 64500) AND ((next_msg_no AND 7) = 0) THEN
  78.           window_write_critical('MSG>Message numbers exceed 64000 --',
  79.                                 ' Issue GR command to renumber soon');
  80.  
  81.         (*-------------------------------------------------------------------*)
  82.         (* Build the message file name and erase any old ones                *)
  83.         (*-------------------------------------------------------------------*)
  84.  
  85.         STR(msg_number, temp_str);
  86.         t_id := opt_block.msg_file_dir + 'BB' + temp_str + '.MSG';
  87.  
  88.         ASSIGN(temp_file, t_id);
  89.         {$I-}
  90.         ERASE(temp_file);
  91.         {$I+}
  92.         i := IORESULT;
  93.  
  94.         (*-------------------------------------------------------------------*)
  95.         (* Rename the temp file to the right name                            *)
  96.         (*-------------------------------------------------------------------*)
  97.  
  98.         ASSIGN(temp_file, fileid);
  99.         RENAME(temp_file, t_id);
  100.  
  101.         (*-------------------------------------------------------------------*)
  102.         (* See if user demanded a BID                                        *)
  103.         (*-------------------------------------------------------------------*)
  104.  
  105.         bid_forced := (LENGTH(msg_bid) = 1) AND (msg_bid[1] <= CHR(1));
  106.  
  107.         (*-------------------------------------------------------------------*)
  108.         (* Ok process bid now                                                *)
  109.         (*-------------------------------------------------------------------*)
  110.  
  111.         {$IFDEF DEBUG_TIME}
  112.           WRITE('!');
  113.         {$ENDIF}
  114.  
  115.         IF (msg_bid <> '') AND NOT bid_forced THEN
  116.           BEGIN;
  117.  
  118.             (*---------------------------------------------------------------*)
  119.             (* This is when a bid has been specified already.  We add it to  *)
  120.             (* The file.  If its not a duplicate, make sure the "generated"  *)
  121.             (* one is not a duplicate either                                 *)
  122.             (*---------------------------------------------------------------*)
  123.  
  124.             bid_is_dupe := bid_add(msg_bid);
  125.             IF NOT bid_is_dupe THEN
  126.               bid_is_dupe := bid_build_test(@active_tcb^.curr_msg.msg_i_mb);
  127.  
  128.           END
  129.         ELSE
  130.  
  131.             (*---------------------------------------------------------------*)
  132.             (* This is when a bid has not been specified.  See if we are to  *)
  133.             (* automatically generate one.  If so then do it.                *)
  134.             (*---------------------------------------------------------------*)
  135.  
  136.           bid_gen;
  137.  
  138.         (*-------------------------------------------------------------------*)
  139.         (* If the bid found or generated is a duplicate, then we put the     *)
  140.         (* message in hold (as requested by options smf and the call)        *)
  141.         (*-------------------------------------------------------------------*)
  142.  
  143.         IF bid_is_dupe AND (NOT bid_forced)
  144.                    AND opt_block.opt_hold_dupe_bid AND (NOT pass_dupe_bid) THEN
  145.           BEGIN;
  146.             IF (msg_flag AND mf_hold) = 0 THEN
  147.               BEGIN;
  148.                 msg_flag := msg_flag OR mf_hold;
  149.                 msg_reason := message_reason_dupbid;
  150.               END;
  151.             send_message(message_reason_dupbid);
  152.           END;
  153.  
  154.         (*-------------------------------------------------------------------*)
  155.         (* If bulletin then check date                                       *)
  156.         (*-------------------------------------------------------------------*)
  157.  
  158.         IF ((msg_flag AND mf_hold) = 0)
  159.                 AND ((msg_type <> mt_private)
  160.                                          OR ((msg_flag AND mf_fwd_list) <> 0))
  161.                 AND (msg_type <> mt_nts)
  162.                 AND (msg_dt_orig < (current_day_time - opt_block.b_fwd_stop))
  163.                 THEN
  164.           BEGIN;
  165.             msg_flag   := msg_flag OR mf_hold;
  166.             msg_reason := message_reason_olddate;
  167.             send_message(message_reason_olddate);
  168.           END;
  169.  
  170.         (*-------------------------------------------------------------------*)
  171.         (* See if user wants some action against it                          *)
  172.         (*-------------------------------------------------------------------*)
  173.  
  174.         (*-------------------------------------------------------------------*)
  175.         (* Set the distribution list name to nothing                         *)
  176.         (*-------------------------------------------------------------------*)
  177.  
  178.         t_id := '';
  179.  
  180.         (*-------------------------------------------------------------------*)
  181.         (* Prepare to loop down the action chain                             *)
  182.         (*-------------------------------------------------------------------*)
  183.  
  184.         {$IFDEF DEBUG_TIME}
  185.           WRITE('@');
  186.         {$ENDIF}
  187.  
  188.         this_act := NIL;
  189.  
  190.         (*-------------------------------------------------------------------*)
  191.         (* If the message is already in hold, skip any hold actions by       *)
  192.         (* indicating that the hold has alreay been done                     *)
  193.         (*-------------------------------------------------------------------*)
  194.  
  195.         IF (msg_flag AND mf_hold) <> 0 THEN
  196.           actions_done := action_msg_hold
  197.         ELSE
  198.           actions_done := 0;
  199.  
  200.         (*-------------------------------------------------------------------*)
  201.         (* Loop down the chain look for our action                           *)
  202.         (*-------------------------------------------------------------------*)
  203.  
  204.         {$IFDEF DEBUG_ACT}
  205.           trace_data('MF2 Act start', msg_number, NIL, msg_to_at);
  206.         {$ENDIF}
  207.  
  208.         GOTO find_next_action; (*- We save a few instructions by doing this -*)
  209.  
  210.         REPEAT
  211.  
  212.           (*-----------------------------------------------------------------*)
  213.           (* Debugging                                                       *)
  214.           (*-----------------------------------------------------------------*)
  215.  
  216.           {$IFDEF DEBUG_ACT}
  217.             trace_data('MF2 ACT1', this_act^.action_type,
  218.                                               this_act, this_act^.action_info);
  219.           {$ENDIF}
  220.  
  221.           (*-----------------------------------------------------------------*)
  222.           (* Set up temp variables                                           *)
  223.           (*-----------------------------------------------------------------*)
  224.  
  225.           temp_type := this_act^.action_type;
  226.  
  227.           (*-----------------------------------------------------------------*)
  228.           (* If we have previously done an action of the same type,          *)
  229.           (* then skip this one                                              *)
  230.           (*-----------------------------------------------------------------*)
  231.  
  232.           IF (temp_type AND actions_done AND action_msg_mask) <> 0 THEN
  233.             GOTO find_next_action;
  234.  
  235.           {$IFDEF DEBUG_ACT}
  236.             trace_data('MF2 ACT2', this_act^.action_type,
  237.                                               this_act, this_act^.action_info);
  238.           {$ENDIF}
  239.  
  240.           (*-----------------------------------------------------------------*)
  241.           (* Set the flags so we know we did one of this type                *)
  242.           (*-----------------------------------------------------------------*)
  243.  
  244.           actions_done := temp_type OR actions_done;
  245.  
  246.           (*-----------------------------------------------------------------*)
  247.           (* If the invert flag is showing then we just ignore the action.   *)
  248.           (* This makes us ignore any further actions on this message of     *)
  249.           (* the same type                                                   *)
  250.           (*-----------------------------------------------------------------*)
  251.  
  252.           IF (temp_type AND action_msg_invert) <> 0 THEN
  253.             GOTO find_next_action;
  254.  
  255.           (*-----------------------------------------------------------------*)
  256.           (* Action is hold, hold_old, or reject (They all set the hold bit  *)
  257.           (*-----------------------------------------------------------------*)
  258.  
  259.           IF (temp_type AND action_msg_hold) <> 0 THEN
  260.             BEGIN;
  261.  
  262.               (*-------------------------------------------------------------*)
  263.               (* Skip hold if in review status                               *)
  264.               (*-------------------------------------------------------------*)
  265.  
  266.               IF (msg_flag AND mf_review) > 0 THEN
  267.                 GOTO find_next_action;
  268.  
  269.               (*-------------------------------------------------------------*)
  270.               (* Turn on the hold bit                                        *)
  271.               (*-------------------------------------------------------------*)
  272.  
  273.               msg_flag := msg_flag OR mf_hold;
  274.  
  275.               (*-------------------------------------------------------------*)
  276.               (* Set the proper reason code                                  *)
  277.               (*-------------------------------------------------------------*)
  278.  
  279.               IF (temp_type AND action_msg_reject) <> 0 THEN
  280.                 msg_reason := message_reason_shouldr
  281.               ELSE
  282.                 IF (temp_type AND action_msg_old) <> 0 THEN
  283.                   msg_reason := message_reason_olddate
  284.                 ELSE
  285.                   msg_reason := message_reason_hold;
  286.  
  287.               (*-------------------------------------------------------------*)
  288.               (* Tell everybody why and leave                                *)
  289.               (*-------------------------------------------------------------*)
  290.  
  291.               send_message(msg_reason);
  292.               GOTO find_next_action;
  293.  
  294.             END;
  295.  
  296.           (*-----------------------------------------------------------------*)
  297.           (* Action is review                                                *)
  298.           (*-----------------------------------------------------------------*)
  299.  
  300.           IF (temp_type AND action_msg_review) <> 0 THEN
  301.             BEGIN;
  302.  
  303.               (*-------------------------------------------------------------*)
  304.               (* Skip review if in hold status                               *)
  305.               (*-------------------------------------------------------------*)
  306.  
  307.               IF (msg_flag AND mf_hold) > 0 THEN
  308.                 GOTO find_next_action;
  309.  
  310.               (*-------------------------------------------------------------*)
  311.               (* Turn on the review bit                                      *)
  312.               (*-------------------------------------------------------------*)
  313.  
  314.               msg_flag := msg_flag OR mf_review;
  315.  
  316.               (*-------------------------------------------------------------*)
  317.               (* Tell everybody why and leave                                *)
  318.               (*-------------------------------------------------------------*)
  319.  
  320.               send_message(message_review);
  321.               GOTO find_next_action;
  322.  
  323.             END;
  324.  
  325.           (*-----------------------------------------------------------------*)
  326.           (* Common code for the rest                                        *)
  327.           (*-----------------------------------------------------------------*)
  328.  
  329.           i       := LENGTH(this_act^.action_info) + 1;
  330.           str_ptr := ADDR(this_act^.action_info[i]);
  331.  
  332.           (*-----------------------------------------------------------------*)
  333.           (* Action is set distribution file name                            *)
  334.           (*-----------------------------------------------------------------*)
  335.  
  336.           IF (temp_type AND action_msg_distr) <> 0 THEN
  337.             BEGIN;
  338.  
  339.               {$IFDEF DEBUG_DIST}
  340.                 WRITELN('Distribution set to ', str_ptr^);
  341.                 DELAY(1000);
  342.               {$ENDIF}
  343.  
  344.               t_id := str_ptr^;
  345.               GOTO find_next_action;
  346.  
  347.             END;
  348.  
  349.           (*-----------------------------------------------------------------*)
  350.           (* Action is change_address                                        *)
  351.           (*-----------------------------------------------------------------*)
  352.  
  353.           IF (temp_type AND action_msg_change) <> 0 THEN
  354.             BEGIN;
  355.  
  356.               (*-------------------------------------------------------------*)
  357.               (* The location of the TO portion of the address has already   *)
  358.               (* calculated.  If not '=' then move it in                     *)
  359.               (*-------------------------------------------------------------*)
  360.  
  361.               IF str_ptr^ <> '=' THEN
  362.                 msg_to := str_ptr^;
  363.  
  364.               (*-------------------------------------------------------------*)
  365.               (* Calculate the location of the @ portion of the address      *)
  366.               (*-------------------------------------------------------------*)
  367.  
  368.               i := i + LENGTH(str_ptr^) + 1;
  369.               str_ptr := ADDR(this_act^.action_info[i]);
  370.  
  371.               (*-------------------------------------------------------------*)
  372.               (* If not '=' then move it in                                  *)
  373.               (*-------------------------------------------------------------*)
  374.  
  375.               IF str_ptr^ <> '=' THEN
  376.                 msg_to_at := str_ptr^;
  377.  
  378.               (*-------------------------------------------------------------*)
  379.               (* Calculate the location of the @.portion of the address      *)
  380.               (*-------------------------------------------------------------*)
  381.  
  382.               i := i + LENGTH(str_ptr^) + 1;
  383.               str_ptr := ADDR(this_act^.action_info[i]);
  384.  
  385.               (*-------------------------------------------------------------*)
  386.               (* If not '=' then move it in                                  *)
  387.               (*-------------------------------------------------------------*)
  388.  
  389.               IF str_ptr^ <> '=' THEN
  390.                 msg_to_h := str_ptr^;
  391.  
  392.             END; (*----- End of CHANGE_ADR ----------------------------------*)
  393.  
  394.           (*-----------------------------------------------------------------*)
  395.           (* Chain to next action                                            *)
  396.           (*-----------------------------------------------------------------*)
  397.  
  398. find_next_action:
  399.  
  400.           msg_action_check(@active_tcb^.curr_msg, this_act);
  401.  
  402.         UNTIL this_act = NIL; (*----- end of loop thru actions --------------*)
  403.  
  404.         {$IFDEF DEBUG_TIME}
  405.           WRITE('#');
  406.         {$ENDIF}
  407.  
  408.         (*-------------------------------------------------------------------*)
  409.         (* Chain the message information onto the msg chain                  *)
  410.         (*-------------------------------------------------------------------*)
  411.  
  412.         i := OFS(msg_index_start^.msg_i_mb.msg_subj[1])
  413.                               - OFS(msg_index_start^)
  414.                               + LENGTH(active_tcb^.curr_msg.msg_i_mb.msg_subj);
  415.         GETMEM(msg_index_current, i);
  416.  
  417.         WITH active_tcb^.curr_msg DO
  418.           BEGIN
  419.  
  420.             IF msg_index_start = NIL THEN
  421.               msg_index_start := msg_index_current
  422.             ELSE
  423.               msg_index_end^.msg_i_next := msg_index_current;
  424.  
  425.             msg_i_last   := msg_index_end;
  426.             msg_i_next   := NIL;
  427.             msg_i_dis    := NIL;
  428.  
  429.             MOVE(active_tcb^.curr_msg, msg_index_current^, i);
  430.  
  431.             msg_index_end := msg_index_current;
  432.  
  433.           END;
  434.  
  435.       END;
  436.  
  437.     (*-----------------------------------------------------------------------*)
  438.     (* Build distribution list  -- Pop calls scanned stack as needed         *)
  439.     (*-----------------------------------------------------------------------*)
  440.  
  441.     {$IFDEF DEBUG_DIST}
  442.       WRITELN('Distribution call to ', t_id);
  443.       DELAY(1000);
  444.     {$ENDIF}
  445.  
  446.     {$IFDEF DEBUG_TIME}
  447.       WRITE('$');
  448.     {$ENDIF}
  449.  
  450.     build_dis(msg_index_current, t_id);
  451.  
  452.     free_task_mem('CS', TRUE);
  453.  
  454.     (*-----------------------------------------------------------------------*)
  455.     (* Add the msg at the end of the msg file                                *)
  456.     (*-----------------------------------------------------------------------*)
  457.  
  458.     {$IFDEF DEBUG_TIME}
  459.       WRITE('%');
  460.     {$ENDIF}
  461.  
  462.     WITH msg_index_current^ DO
  463.       BEGIN;
  464.  
  465.         (*-------------------------------------------------------------------*)
  466.         (* Open the msg file                                                 *)
  467.         (*-------------------------------------------------------------------*)
  468.  
  469.         RESET(msg_file);
  470.  
  471.         (*-------------------------------------------------------------------*)
  472.         (* Get the file size                                                 *)
  473.         (*-------------------------------------------------------------------*)
  474.  
  475.         j := FILESIZE(msg_file);
  476.  
  477.         (*-------------------------------------------------------------------*)
  478.         (* Verify gotten size versus calculated size                         *)
  479.         (*-------------------------------------------------------------------*)
  480.  
  481.         IF j <> next_record_no THEN
  482.           BEGIN;
  483.  
  484.             (*---------------------------------------------------------------*)
  485.             (* The file sizes do not agree... PANIC                          *)
  486.             (*---------------------------------------------------------------*)
  487.  
  488.             WRITELN('Next record number computed and actual do not agree');
  489.             WRITELN('Computed =', next_record_no, ' Actual   =', j);
  490.             IF next_record_no > j THEN
  491.               j := next_record_no
  492.             ELSE
  493.               next_record_no := j;
  494.  
  495.           END;
  496.  
  497.         (*-------------------------------------------------------------------*)
  498.         (* Position to the proper place                                      *)
  499.         (*-------------------------------------------------------------------*)
  500.  
  501.         msg_i_record := j;
  502.  
  503.         SEEK(msg_file, msg_i_record);
  504.  
  505.         (*-------------------------------------------------------------------*)
  506.         (* Write main record and any distribution list                       *)
  507.         (*-------------------------------------------------------------------*)
  508.  
  509.         WRITE(msg_file, msg_i_mb);
  510.         INC(next_record_no);
  511.  
  512.         IF (msg_i_mb.msg_flag AND mf_fwd_list) <> 0 THEN
  513.           BEGIN;
  514.  
  515.             {$IFDEF POINT_CHK}
  516.               test_pointer(msg_i_dis);
  517.             {$ENDIF}
  518.  
  519.             buff_add := @msg_i_dis^;
  520.  
  521.             WRITE(msg_file, buff_add^);
  522.  
  523.             INC(next_record_no);
  524.  
  525.           END;
  526.  
  527.         (*-------------------------------------------------------------------*)
  528.         (* CLose up the file                                                 *)
  529.         (*-------------------------------------------------------------------*)
  530.  
  531.         CLOSE(msg_file);
  532.  
  533.       END;
  534.  
  535.     {$IFDEF DEBUG_TIME}
  536.       WRITE('^');
  537.     {$ENDIF}
  538.  
  539.     (*-----------------------------------------------------------------------*)
  540.     (* Release the interrupt lock                                            *)
  541.     (*-----------------------------------------------------------------------*)
  542.  
  543.     free_semaphore(semaphore_interrupts);
  544.  
  545.     (*-----------------------------------------------------------------------*)
  546.     (* Put the message info in the tcb                                       *)
  547.     (*-----------------------------------------------------------------------*)
  548.  
  549.     active_tcb^.curr_msg := msg_index_current^;
  550.  
  551.     (*-----------------------------------------------------------------------*)
  552.     (* Count the message                                                     *)
  553.     (*-----------------------------------------------------------------------*)
  554.  
  555.     INC(msg_counter_ok);
  556.  
  557.   END;
  558.  
  559. (*===========================================================================*)
  560. (* Update a msg record                                                       *)
  561. (*===========================================================================*)
  562.  
  563. PROCEDURE update_msg (i_ptr  : msg_index_ptr);
  564.  
  565.   VAR
  566.     buff_add : msg_block_ptr;
  567.     d_ptr    : msg_d_ptr;
  568.     i        : INTEGER;
  569.     j        : WORD;
  570.  
  571.   BEGIN;
  572.  
  573.     (*-----------------------------------------------------------------------*)
  574.     (* Catch an error                                                        *)
  575.     (*-----------------------------------------------------------------------*)
  576.  
  577.     IF i_ptr = NIL THEN
  578.       BEGIN;
  579.         WRITELN('NIL ptr passed to update.  Operation ignored');
  580.         EXIT;
  581.       END;
  582.  
  583.     {$IFDEF POINT_CHK}
  584.       test_pointer(i_ptr);
  585.     {$ENDIF}
  586.  
  587.     (*-----------------------------------------------------------------------*)
  588.     (* Obtain the interrupt lock                                             *)
  589.     (*-----------------------------------------------------------------------*)
  590.  
  591.     get_semaphore(semaphore_interrupts, sem_exclusive, FALSE);
  592.  
  593.     WITH i_ptr^, i_ptr^.msg_i_mb DO
  594.       BEGIN;
  595.  
  596.         (*-------------------------------------------------------------------*)
  597.         (* Open the file and set position                                    *)
  598.         (*-------------------------------------------------------------------*)
  599.  
  600.         RESET(msg_file);
  601.  
  602.         (*-------------------------------------------------------------------*)
  603.         (* Get the file size                                                 *)
  604.         (*-------------------------------------------------------------------*)
  605.  
  606.         j := FILESIZE(msg_file);
  607.  
  608.         (*-------------------------------------------------------------------*)
  609.         (* Verify gotten size versus calculated size and the position wanted *)
  610.         (*-------------------------------------------------------------------*)
  611.  
  612.         IF (j <> next_record_no) OR (j < msg_i_record) THEN
  613.           BEGIN;
  614.  
  615.             (*---------------------------------------------------------------*)
  616.             (* The file sizes do not agree... PANIC                          *)
  617.             (*---------------------------------------------------------------*)
  618.  
  619.             WRITELN;
  620.             WRITELN('Next record number computed and actual do not agree');
  621.             WRITELN('or seek malfunction');
  622.             WRITELN('Computed =', next_record_no, ' Actual   =', j,
  623.                                                   ' Seek     =', msg_i_record);
  624.             WRITELN;
  625.             RUNERROR(msg_runerr);
  626.  
  627.           END;
  628.  
  629.         (*-------------------------------------------------------------------*)
  630.         (* Set Position                                                      *)
  631.         (*-------------------------------------------------------------------*)
  632.  
  633.         SEEK(msg_file, msg_i_record);
  634.  
  635.         (*-------------------------------------------------------------------*)
  636.         (* Update the primary record                                         *)
  637.         (*-------------------------------------------------------------------*)
  638.  
  639.         WRITE(msg_file, msg_i_mb);
  640.  
  641.         (*-------------------------------------------------------------------*)
  642.         (* If a distribution list is present, update it too!                 *)
  643.         (*-------------------------------------------------------------------*)
  644.  
  645.         IF (msg_i_mb.msg_flag AND mf_fwd_list) <> 0 THEN
  646.           BEGIN;
  647.  
  648.             (*---------------------------------------------------------------*)
  649.             (* Find the distribution block pointer.  See if routing block    *)
  650.             (* is present                                                    *)
  651.             (*---------------------------------------------------------------*)
  652.  
  653.             IF (msg_i_mb.msg_flag AND mf_disrout) <> 0 THEN
  654.               BEGIN;
  655.                 {$IFDEF POINT_CHK}
  656.                   test_pointer(msg_i_dr);
  657.                 {$ENDIF}
  658.                 d_ptr := msg_i_dr^.msg_dr_dblk
  659.               END
  660.             ELSE
  661.               d_ptr := msg_i_dis;
  662.  
  663.             (*---------------------------------------------------------------*)
  664.             (* Is the distribution block present?  If not don't update       *)
  665.             (*---------------------------------------------------------------*)
  666.  
  667.             IF d_ptr <> NIL THEN
  668.               BEGIN;
  669.  
  670.                 {$IFDEF POINT_CHK}
  671.                   test_pointer(d_ptr);
  672.                 {$ENDIF}
  673.  
  674.                 (*-----------------------------------------------------------*)
  675.                 (* Get number of items in the array                          *)
  676.                 (*-----------------------------------------------------------*)
  677.  
  678.                 i := d_ptr^.msg_d_no;
  679.  
  680.                 (*-----------------------------------------------------------*)
  681.                 (* Validate                                                  *)
  682.                 (*-----------------------------------------------------------*)
  683.  
  684.                 IF i > msg_dist_max THEN
  685.                   BEGIN;
  686.                     WRITELN('MF2 Invalid distribution # -- ', i ,
  687.                             ' -- # ', msg_i_mb.msg_number);
  688.                     dump_reason('Invalid distribution # MF2');
  689.                     dump_trace;
  690.                     dump_msg(i_ptr);
  691.                     RUNERROR(msg_runerr);
  692.                   END;
  693.  
  694.                 (*-----------------------------------------------------------*)
  695.                 (* Write the record out                                      *)
  696.                 (*-----------------------------------------------------------*)
  697.  
  698.                 buff_add := ADDR(d_ptr^);
  699.  
  700.                 WRITE(msg_file, buff_add^);
  701.  
  702.               END;
  703.  
  704.           END; (*----- End distribution list update -------------------------*)
  705.  
  706.         (*-------------------------------------------------------------------*)
  707.         (* Done with the file!                                               *)
  708.         (*-------------------------------------------------------------------*)
  709.  
  710.         {$I-}
  711.         CLOSE(msg_file);
  712.         {$I+}
  713.         i := IORESULT;
  714.  
  715.         (*-------------------------------------------------------------------*)
  716.         (* Release the interrupt lock                                        *)
  717.         (*-------------------------------------------------------------------*)
  718.  
  719.         free_semaphore(semaphore_interrupts);
  720.  
  721.       END;
  722.  
  723.     (*-----------------------------------------------------------------------*)
  724.     (* Count the messages                                                    *)
  725.     (*-----------------------------------------------------------------------*)
  726.  
  727.     count_msg_list;
  728.  
  729.   END;
  730.